home *** CD-ROM | disk | FTP | other *** search
/ Mac Format 1995 June / MacFormat 25.iso / Shareware City / Developers / fortran-to-c-translator-11 / Mac F2C 1.1 / Test Project ƒ / test.f < prev    next >
Text File  |  1995-01-28  |  5KB  |  193 lines
  1.     Program test_f2c
  2.     
  3. c    This is a FORTRAN program to test Mac F2C v1.1
  4.  
  5.     character    junk*2
  6.  
  7.     write( 6, * ) '*****   Input/Output Test   *****'
  8.     call i_o_test
  9.     write(6,*) '\n*****   End of I/O test, hit return to continue...'
  10.     read(5,99) junk
  11. 99    format( a1 )
  12.  
  13.     write( 6, *) '\n*****   Integer Math Test   *****'    
  14.     call int_test( 10 )
  15.     write(6,*) '\n*****   End of integer math test, hit return to continue...'
  16.     read(5,99) junk
  17.  
  18.     write( 6, * ) '\n*****   Floating Point Math Test   *****'
  19.     call flt_test( 10 )
  20.     write(6,*) '\n*****   End of floating point math test, hit return to continue...'
  21.     read(5,99) junk
  22.  
  23.     write( 6, * ) '\n*****   Transcendental Function Test   *****'
  24.     call trn_test
  25.     write(6,*) '\n*****   End of transcendental function test, hit return to continue...'
  26.     read(5,99) junk
  27.     
  28.     write(6,*) '##########################################################################'
  29.     write(6,*) ' If you noticed that floating point values did not round correctly when'
  30.     write(6,*) ' displayed, please read the enclosed file "If Floats Don\'t Display Right"'
  31.     write(6,*) '##########################################################################'
  32.     write( 6, * ) '\n*****   This completes all of the tests   *****'
  33.     
  34.     stop
  35.     end
  36.     
  37.     
  38.  
  39. c************************************************************************
  40. c
  41. c    Subroutine to do the I/O tests
  42. c
  43. c************************************************************************
  44.     
  45.     subroutine  i_o_test
  46.     dimension a(5), j(5)
  47.     double precision  dx
  48.     character text*40
  49.     
  50. c     Screen I/O tests
  51.  
  52.     write(6,*) '\nPart 1:  Screen I/O tests.\n\nEnter an integer value.'
  53.     read(5,*) i
  54.     write(6,*) 'The number you entered was:', i
  55.  
  56.     write(6,*) '\nEnter a single precision floating point value...'
  57.     read(5,*) x
  58.     write(6,*) 'The number you entered was: ', x
  59.  
  60.     write(6,*) '\nEnter a double precision floating point value...'
  61.     read(5,*) dx
  62.     write(6,*) 'The number you entered was: ', dx
  63.  
  64.     write(6,*) '\nEnter some text (40 char max)...'
  65.     read(5,*) text
  66.     write(6,*) 'The text you entered was: ', text
  67.     
  68.     write(6,*) '\nPart 2:  file I/O tests.  Hit return to continue...'
  69.     read(5,399) text
  70. 399    format( a1 )
  71.     
  72. c     File I/O tests:  Store some values and write them to file
  73.  
  74.     do i = 1,5
  75.       j(i) = i
  76.       a(i) = dble(i)
  77.     enddo
  78.     text = 'A test message.'
  79.     open(60,file='test.dat',form='unformatted')
  80.     write(60) text, j, a
  81.     close(60)
  82.     
  83.     write(6,*) 'Wrote the following data to file test.dat:\n'
  84.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  85. 304    format( 5x, a20, 5(i1, 2x), 5x, 5(f4.2, 2x) )
  86.  
  87. c Reset the variables and read them back
  88.  
  89.     do i = 1,5
  90.       j(i) = 99
  91.       a(i) = 99
  92.     enddo
  93.     text = 'reset'
  94.     open(50,file='test.dat',form='unformatted')
  95.     read(50) text, j, a
  96.     close(50)
  97.     
  98.     write(6, *) '\nRead the following data from file test.dat:\n' 
  99.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  100.  
  101.     return
  102.     end
  103.     
  104.     
  105.     
  106.     
  107. c************************************************************************
  108. c
  109. c    Subroutine to do the integer math tests
  110. c
  111. c************************************************************************
  112.  
  113.     subroutine  int_test( m )
  114.     write( 6, *) '\nGenerate a table of integers, squares, cubes, and their halves.\n'
  115.     write(6, 203)
  116. 203    format( 10x, 'n', 5x, 'n^2', 5x, 'n^3', 5x, 'n/2', 3x, 'n^2/2', 3x, 'n^3/2' )
  117.     do i = 1, m
  118.         j = i**2
  119.         k = i**3
  120.         write( 6, 202 )  i, j, k, i/2, j/2, k/2
  121. 202        format( 5x, 6( i6, 2x ) )
  122.     end do
  123.     return
  124.     end
  125.  
  126.  
  127.  
  128. c************************************************************************
  129. c
  130. c    Subroutine to do the floating point math tests
  131. c
  132. c************************************************************************
  133.  
  134.     subroutine  flt_test( m )
  135.     write( 6, * ) '\nGenerate a table of floats, their squares, cubes, and their halves.\n'
  136.     write(6, 205)
  137. 205    format( 12x, 'x', 6x, 'x^2', 6x, 'x^3', 6x, 'x/2', 4x, 'x^2/2', 4x, 'x^3/2' )
  138.     do i = 1, m
  139.         x1 = i*1.0
  140.         x2 = x1**2
  141.         x3 = x1**3
  142.         write( 6, 201 )  x1, x2, x3, x1/2, x2/2, x3/2
  143. 201        format( 5x, 6( f8.2, 1x ) )
  144.     end do
  145.     return
  146.     end
  147.  
  148.  
  149.  
  150.  
  151. c************************************************************************
  152. c
  153. c    Subroutine to do the transcendental function tests
  154. c
  155. c************************************************************************
  156.  
  157.     subroutine  trn_test
  158.     double precision  pi, x, s, c, s2, c2
  159.     character junk*2
  160.     
  161.     pi = 3.141592653589793
  162.     write( 6, * ) '\nPart 1: Trig Functions'
  163.     write( 6, *) '\nGenerate a table of x, sin(x), cos(x) and the sum of their squares.\n'
  164.     write(6, 207)
  165. 207    format( 9x, 'x', 10x, 'sin(x)', 8x, 'cos(x)', 3x, 'sin(x)^2 + cos(x)^2' )
  166.     do i = 1, 12
  167.         x = i * pi / 6.0
  168.         s = dsin( x )
  169.         c = dcos( x )
  170.         s2 = s**2
  171.         c2 = c**2
  172.         write( 6, 200) i, s, c, s2 + c2
  173. 200        format( 5x, i2,'*pi/6' 3x, f11.8, 3x, f11.8, 3x, f15.10 )
  174.     end do
  175.  
  176.     write(6,*) '\nPart 2:  Exponential functions; hit return to continue...'
  177.     read(5,299) junk
  178. 299    format( a1 )
  179.  
  180.     write(6,*) 'Generate a table of x, log(x), and exp(log(x))\n'
  181.     write(6, 208)
  182. 208    format( 11x, 'x', 16x, 'log(x)', 9x, 'exp(log(x))' )
  183.     do i = 1, 10
  184.         x = dble(i)
  185.         s = dlog(x)
  186.         c = dexp(s)
  187.         write(6, 201) x, s, c
  188. 201        format( 5x, f13.10, 5x, f13.10, 5x, f13.10 )
  189.     end do
  190.     
  191.     return
  192.     end
  193.